home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacPerl 4.1.3 / lib / macftp.pl < prev    next >
Encoding:
Perl Script  |  1993-10-23  |  9.7 KB  |  416 lines  |  [TEXT/MPS ]
  1. #!/usr/local/bin/perl
  2. #   This is a set of ftp library routines using chat2.pl
  3. # 
  4. #   Return code information taken from RFC 959
  5.  
  6. #   Written by Gene Spafford  <spaf@cs.purdue.edu>
  7. #       Last update: 10 April 92,   Version 0.9
  8. #
  9.  
  10. # put() and port to MacPerl M. Neeracher <neeri@iis.ethz.ch>
  11.  
  12. #
  13. #   Most of these routines communicate over an open ftp channel
  14. #   The channel is opened with the "ftp'open" call.
  15. #
  16.  
  17. package ftp;
  18. require "macchat.pl";
  19. require "GUSI.ph";
  20.  
  21. ###########################################################################
  22. #
  23. #  The following are the variables local to this package.
  24. #  I declare them all up front so I can remember what I called 'em. :-)
  25. #
  26. ###########################################################################
  27.  
  28. LOCAL_VARS: {    
  29.     $Control;
  30.     $Data_handle;
  31.     $Host;
  32.     $Myhost = "Some.Poor.Mac";
  33. # Currently no way to do gethostname
  34.     $NeedsCleanup;
  35.     $NeedsClose;
  36.     $ftp_error;
  37.     $ftp_matched;
  38.     $ftp_trans_flag;
  39.     $ftp_echo;
  40.     @ftp_list;
  41.  
  42.     local(@tmp) = getservbyname("ftp", "tcp");
  43.     ($FTP = $tmp[2]) || 
  44.     die "Unable to get service number for 'ftp' (in ftplib)!\n";
  45.  
  46.     @std_actions = (
  47.         'TIMEOUT',
  48.         q($ftp_error = "Connection timed out for $Host!\n"; undef),
  49.         'EOF', 
  50.         q($ftp_error = "Connection to $Host timed out unexpectedly!\n"; undef)
  51.     );
  52.  
  53.     @sigs = ('INT', 'HUP', 'TERM', 'QUIT');  # sigs we'll catch & terminate on
  54. }
  55.  
  56.  
  57.  
  58. ###########################################################################
  59. #
  60. #  The following are intended to be the user-callable routines.
  61. #  Each of these does one of the ftp keyword functions.
  62. #
  63. ###########################################################################
  64.  
  65. sub error { ## Public
  66.     $ftp_error;
  67. }
  68.  
  69. sub echo { ## Public
  70.     ($ftp_echo) = @_;
  71. }
  72.   
  73. #######################################################
  74.  
  75. #   cd up a directory level
  76.  
  77. sub cdup { ## Public
  78.     &do_ftp_cmd(200, "cdup");
  79. }
  80.  
  81. #######################################################
  82.  
  83. # close an open ftp connection
  84.  
  85. sub close { ## Public
  86.     return unless $NeedsClose;
  87.     &do_ftp_cmd(221, "quit");
  88.     &macchat'close($Control);
  89.     undef $NeedsClose;
  90.     &do_ftp_signals(0);
  91. }
  92.  
  93. #######################################################
  94.  
  95. # change remote directory
  96.  
  97. sub cwd { ## Public
  98.     &do_ftp_cmd(250, "cwd", @_);
  99. }
  100.   
  101. #######################################################
  102.  
  103. #  delete a remote file
  104.  
  105. sub delete { ## Public
  106.      &do_ftp_cmd(250, "dele", @_); 
  107. }
  108.  
  109. #######################################################
  110.  
  111. #  get a directory listing of remote directory ("ls -l")
  112.  
  113. sub dir { ## Public
  114.     &do_ftp_listing("list", @_);
  115. }
  116.  
  117. #######################################################
  118.  
  119. #  get a remote file to a local file
  120. #    get(remote[, local])
  121.  
  122. sub get { ## Public
  123.     local($remote, $local) = @_;
  124.     ($local = $remote) unless $local;
  125.  
  126.     unless (open(DFILE, ">$local")) {
  127.     $ftp_error =  "Open of local file $local failed: $!";
  128.     return undef;
  129.     } else {
  130.     $NeedsCleanup = $local;
  131.     }
  132.  
  133.     return undef unless &do_open_dport;     # Open a data channel
  134.     unless (&do_ftp_cmd(150, "retr $remote")) {
  135.     $ftp_error .= "\nFile $remote not fetched from $Host\n";
  136.     close DFILE;
  137.     unlink $local;
  138.     undef $NeedsCleanup;
  139.     return;
  140.     }
  141.  
  142.     $ftp_trans_flag = 0;
  143.  
  144.     do {
  145.     &macchat'expect($Data_handle, 60,
  146.              '.|\n', q{$macchat'thisbuf =~ s|\015\012|\n|g;
  147.                                print DFILE ($macchat'thisbuf) ||
  148.             ($ftp_trans_flag = 3); undef $macchat'S},
  149.              'EOF',  '$ftp_trans_flag = 1',
  150.              'TIMEOUT', '$ftp_trans_flag = 2');
  151.     } until $ftp_trans_flag;
  152.  
  153.     close DFILE;
  154.     &macchat'close($Data_handle);        # Close the data channel
  155.  
  156.     undef $NeedsCleanup;
  157.     if ($ftp_trans_flag > 1) {
  158.     unlink $local;
  159.     $ftp_error = "Unexpected " . ($ftp_trans_flag == 2 ? "timeout" :
  160.         ($ftp_trans_flag != 3 ? "failure" : "local write failure")) .
  161.                 " getting $remote\n";
  162.     }
  163.     
  164.     &do_ftp_cmd(226);
  165. }
  166.  
  167. #######################################################
  168.  
  169. #  put a local file to a remote file
  170. #    put(local[, remote])
  171.  
  172. sub put { ## Public
  173.     local($local, $remote) = @_;
  174.     ($remote = $local) unless $remote;
  175.  
  176.     unless (open(DFILE, "<$local")) {
  177.     $ftp_error =  "Open of local file $local failed: $!";
  178.     return undef;
  179.     } 
  180.  
  181.     return undef unless &do_open_dport;     # Open a data channel
  182.     unless (&do_ftp_cmd(150, "stor $remote")) {
  183.     $ftp_error .= "\nFile $remote not stored on $Host\n";
  184.     close DFILE;
  185.     return undef;
  186.     }
  187.  
  188.     &macchat'expect($Data_handle, 0);              # Force macchat to do an accept
  189.  
  190.     while (<DFILE>) {
  191.         chop;
  192.     &macchat'print($Data_handle, "$_\015\012");
  193.     }
  194.  
  195.     close DFILE;
  196.     &macchat'close($Data_handle);                # Close the data channel
  197.     
  198.     &do_ftp_cmd(226);
  199. }
  200.  
  201. #######################################################
  202.  
  203. #  Do a simple name list ("ls")
  204.  
  205. sub list { ## Public
  206.     &do_ftp_listing("nlst", @_);
  207. }
  208.  
  209. #######################################################
  210.  
  211. #   Make a remote directory
  212.  
  213. sub mkdir { ## Public
  214.     &do_ftp_cmd(257, "mkd", @_);
  215. }
  216.  
  217. #######################################################
  218.  
  219. #  Open an ftp connection to remote host
  220.  
  221. sub open {  ## Public
  222.     if ($NeedsClose) {
  223.     $ftp_error = "Connection still open to $Host!";
  224.     return undef;
  225.     }
  226.  
  227.     $Host = shift(@_);
  228.  
  229.     local($Port) = $FTP;
  230.  
  231.     if ($Host =~ /(.*)\s+([0-9]+)/) {
  232.     ($Host, $Port) = ($1, $2);
  233.     }
  234.  
  235.     local($User, $Password, $Acct) = @_;
  236.     $User = "anonymous" unless $User;
  237.     $Password = "-" . $main'ENV{'USER'} . "@$Myhost" unless $Password;
  238.     $ftp_error = '';
  239.  
  240.     unless($Control = 
  241.         &macchat'open_port(
  242.         &GUSI'AF_INET, &GUSI'pack_sockaddr_in(&GUSI'AF_INET, $Host, $Port))) {
  243.     $ftp_error = "Unable to connect to $Host";
  244.     if ($Port == $FTP) {
  245.         $ftp_error .= " ftp port: $!";
  246.     } else {
  247.         $ftp_error .= " port $Port: $!";
  248.     }
  249.     return undef;
  250.     }
  251.  
  252.     unless(&macchat'expect($Control, 60,
  253.                 '^220 .*\015\012',    "1",
  254.                 '^\d\d\d .*\015\012',      "undef")) {
  255.     $ftp_error = "Error establishing control connection to $Host";
  256.         &macchat'close($Control);
  257.     return undef;
  258.     }
  259.     &do_ftp_signals($NeedsClose = 1);
  260.  
  261.     unless (&do_ftp_cmd(331, "user $User")) {
  262.     $ftp_error .= "\nUser command failed establishing connection to $Host";
  263.     return undef;
  264.     }
  265.  
  266.     unless (&do_ftp_cmd("(230|332|202)", "pass $Password")) {
  267.     $ftp_error .= "\nPassword command failed establishing connection to $Host";
  268.     return undef;
  269.     }
  270.  
  271.     return 1 unless $Acct;
  272.  
  273.     unless (&do_ftp_cmd("(230|202)", "pass $Password")) {
  274.     $ftp_error .= "\nAcct command failed establishing connection to $Host";
  275.     return undef;
  276.     }
  277.     1;
  278. }
  279.  
  280. #######################################################
  281.  
  282. #  Get name of current remote directory
  283.  
  284. sub pwd { ## Public
  285.     if (&do_ftp_cmd(257, "pwd")) {
  286.     $ftp_matched =~ m/^257 (.+)\015?\012/;
  287.     $1;
  288.     } else {
  289.     undef;
  290.     }    
  291. }
  292.  
  293. #######################################################
  294.  
  295. #  Rename a remote file
  296.  
  297. sub rename { ## Public
  298.     local($from, $to) = @_;
  299.  
  300.     &do_ftp_cmd(350, "rnfr $from") && &do_ftp_cmd(250, "rnto $to");
  301. }
  302.  
  303. #######################################################
  304.  
  305. #  Set transfer type
  306.  
  307. sub type { ## Public
  308.     &do_ftp_cmd(200, "type", @_); 
  309. }
  310.  
  311.  
  312. ###########################################################################
  313. #
  314. #  The following are intended to be utility routines used only locally.
  315. #  Users should not call these directly.
  316. #
  317. ###########################################################################
  318.  
  319. sub do_ftp_cmd {  ## Private
  320.     local($okay, @commands, $val) = @_;
  321.  
  322.     $ftp_echo && $commands[0] && 
  323.     print STDERR join(" ", @commands) . "\015\012";
  324.     $commands[0] && 
  325.     &macchat'print($Control, (join(" ", @commands) . "\015\012"));
  326.  
  327.     &macchat'expect($Control, 60, 
  328.          "^$okay .*\\015\\012",    'print STDERR $& if $ftp_echo;
  329.                      $ftp_matched = $&; 1',
  330.          "^(\d)\d\d .*\\015\\012", '($String = $&) =~ y/\015\012//d;
  331.                      print STDERR $& if $ftp_echo;
  332.              $ftp_error = qq{Unexpected reply for ' .
  333.              "@commands" . ': $String}; 
  334.              $1 > 3 ? undef : 1',
  335.          @std_actions
  336.         );
  337. }
  338.  
  339. #######################################################
  340.  
  341. sub do_ftp_listing { ## Private
  342.     local(@lcmd) = @_;
  343.     @ftp_list = ();
  344.     $ftp_trans_flag = 0;
  345.  
  346.     return undef unless &do_open_dport;
  347.  
  348.     return undef unless &do_ftp_cmd(150, @lcmd);
  349.     do {            #  Following is grotty, but macchat2 makes us do it
  350.         &macchat'expect($Data_handle, 30,
  351.         '(.*\n?\012)',    'push(@ftp_list, $1)',
  352.         "EOF",     '$ftp_trans_flag = 1');
  353.     } until $ftp_trans_flag;
  354.  
  355.     &macchat'close($Data_handle);
  356.     return undef unless &do_ftp_cmd(226);
  357.  
  358.     grep(y/\015\012//d, @ftp_list);
  359.     @ftp_list;
  360. }  
  361.  
  362. #######################################################
  363.  
  364. sub do_open_dport { ## Private
  365.     local(@foo, $fam, $addr, $port) = &macchat'open_listen(&GUSI'AF_INET);
  366.     ($port, $Data_handle) = @foo;
  367.     ($fam,$addr,$port) = &GUSI'unpack_sockaddr_in($port);
  368.  
  369.     unless ($Data_handle) {
  370.     $ftp_error =  "Unable to open data port: $!";
  371.     return undef;
  372.     }
  373.  
  374.     $addr =~ tr/./,/;
  375.     @foo = ($port >> 8, $port & 0xff);
  376.     $addr .= "," . join(',', @foo);
  377.     
  378.     &do_ftp_cmd(200, "port $addr");
  379. }
  380.  
  381. #######################################################
  382. #
  383. #  To cleanup after a problem
  384. #
  385.  
  386. sub do_ftp_abort {
  387.     die unless $NeedsClose;
  388.  
  389.     &macchat'print($Control, "abor", "\015\012");
  390.     &macchat'close($Data_handle);
  391.     &macchat'expect($Control, 10, '.', undef);
  392.     &macchat'close($Control);
  393.  
  394.     close DFILE;
  395.     unlink($NeedsCleanup) if $NeedsCleanup;
  396.     die;
  397. }
  398.  
  399. #######################################################
  400. #
  401. #  To set signals to do the abort properly
  402. #
  403.  
  404. sub do_ftp_signals {
  405.     local($flag, $sig) = @_;
  406.  
  407.     local ($old, $new) = ('DEFAULT', "ftp'do_ftp_abort");
  408.     $flag || (($old, $new) = ($new, $old));
  409.     foreach $sig (@sigs) {
  410.     ($SIG{$sig} == $old) && ($SIG{$sig} = $new);
  411.     }
  412. }
  413.  
  414. 1;
  415.  
  416.